;;;
;;; texture-arb.lisp
;;;

(in-package :lib.gl)

(export '(texture-arb enable-texture disable-texture))

;;; Texture Support

(defclass texture-arb (xml-serializer)
  ((source :reader source :initarg :source :initform nil)
   (type :accessor type :initarg :type :initform :texture-2d)
   (binding :accessor binding :initarg :binding :initform 0)
   (width :accessor texture-width :initarg :width :initform 0.0)
   (height :accessor texture-height :initarg :height :initform 0.0)
   (repeat :accessor texture-repeat :initarg :repeat :initform nil)
   (mag-filter :accessor mag-filter :initarg :mag-filter :initform :linear)
   (min-filter :accessor min-filter :initarg :min-filter :initform :linear)))


(defun %sdl-texture-from-source (source type mag-filter min-filter repeat &optional (tex-name 0))
  ;;; Adapted from Apple's OpenGL Programming Guide for sdl and cl-opengl
  (sdl:with-pixel (data (sdl:fp (sdl:load-image source)))
    (let* ((surface (sdl:load-image source))
	   (ncolors (sdl-base::pixel-bbp data))
	   ;(img-format (sdl-base::format ))
	   (width (sdl:width surface))
	   (height (sdl:height surface))
	   (texture (car (gl:gen-textures 1))))
      (if (null source)
	  (warn "Could not find image data at URL ~A." source)) 
      (log5:log-for (log5:lib.gl) "Let's write this sucker to a texture.")
      (gl:bind-texture type texture)
      (gl:tex-parameter type :texture-wrap-s (if Repeat :repeat :clamp-to-edge))
      (gl:tex-parameter type :texture-wrap-t (if Repeat :repeat :clamp-to-edge))
      (gl:tex-parameter type :texture-mag-filter mag-filter)
      (gl:tex-parameter type :texture-min-filter min-filter)
      (log5:log-for (log5:lib.gl) "Pixel data ~A, width ~A, height ~A, BPP ~A." (sdl-base::pixel-data data)
		    width height (sdl-base::pixel-bpp data))
      (gl:tex-image-2d type 0 (sdl-base::pixel-bbp data) width height
		       0 :bgra :unsigned-int (sdl-base::pixel-data data))
      (values tex-name (coerce width 'float) (coerce height 'float)))))

(defmethod initialize-instance :after ((tex texture-arb) &rest initargs)
  (declare (ignore initargs))
  (format t "Initializing texture-arb ~A~%" tex)
  (when (probe-file (source tex))
    (load-texture tex)))

(defmethod load-texture ((tex texture-arb))
  (with-slots (glview source type binding width height min-filter mag-filter repeat) tex
					;(format t "Got here: ~A, ~A~%" glview source)
    (multiple-value-bind (name w h)
	(%gl-texture-image-from-source source type mag-filter min-filter repeat)
      (setf binding name
	    width w
	    height h))))

(defmethod enable-texture ((tex texture-arb))
  (gl:enable (type tex))
  (gl:bind-texture (type tex) (binding tex)))

(defmethod disable-texture ((tex texture-arb))
  (gl:disable (type tex)))

(defclass texture-grid (texture-arb)
  ((options :accessor texture-grid-options :initarg :options)
   (info :accessor texture-grid-info :initarg :info)
   (names :accessor texture-grid-names :initarg :names)))

(defun process-grid-entries (names entries)
  (flet ((get-option (option-name)
	   (assoc option-name entries)))
    (let ((ox (cadr (get-option :x_top_left)))
	  (oy (cadr (get-option :y_top_left)))
	  (dx (cadr (get-option :dx)))
	  (dy (cadr (get-option :dy)))
	  (format (cadr (assoc :format (cdr (get-option :tiles))))) ;; Ignore for the moment
	  (data (cadr (assoc :data (cdr (get-option :tiles))))))
      (declare (ignore format))
      (iter (for (row col name) in data)
	    (after-each (let* ((sx (coerce (+ ox (* col dx)) 'single-float))
			       (sy (coerce (+ oy (* row dy)) 'single-float))
			       (ex (coerce (+ sx dx) 'single-float))
			       (ey (coerce (+ sy dy) 'single-float)))
			  (setf (gethash name names) (list sx sy ex ey))))))))

(defun make-texture-grid-from-spec-file (path view)
  (when (probe-file path)
    (with-open-file (s path :direction :input :if-does-not-exist :error)
      (let* ((alldata (read s))
	     options source info
	     (grid-data (make-hash-table :test 'equal)))
	(unless (eql (car alldata) :spec)
	  (error "Data in ~A does not specify a texture grid!" path))
	(iter (for form in (rest alldata))
	      (after-each (case (car form)
			    (:options (setf options (cadr form)))
			    (:info (setq info (cadr form)))
			    (:file (setq source (cadr form)))
			    (:grid (process-grid-entries grid-data (cdr form))))))
	(make-instance 'texture-grid :source source :info info :options options :names grid-data :glview view)))))	
